00100	TITLE COLOR
00200	EXTERN NUMVAL,FIX1A,STATUS,TSERVO,L1,L2,L3
00300	A←1
00400	B←2
00500	C←3
00510	D←4
00520	EE←5
00600	P←14
00700	I←4
00800	J←5
00900	K←6
01000	L←7
01100	M←10
01200	N←11
01300	OPDEF CALL[34B8]
01400	OPDEF JCALL[35B8]
01500	OPDEF SPCWAR[43B8]
01600
01700	TSINIT:	MOVEI 1,11
01800		MOVE 1,STATUS
01900		SPCWAR 0,636367
02000		SPCWAR 1,TSERVO
02100		SETZ 1,
02200		POPJ P,
02210	
02220	SWS:	CALLI 400000
02230		ANDI 377
02240		JCALL 1,FIX1A
02300
02400	CTVF1:	MOVEM AC
02500		MOVE [XWD 1,AC+1]
02600		BLT AC+17
02700		MOVEI I,3
02800	TV2:	MOVEI J,10
02900	TV3:	PUSHJ P,INTV
03000		PUSHJ P,TVAD
03100		SOJG J,TV3
03200		PUSHJ P,LENS
03205		MOVEI J,4	;SLEEP
03210		CALLI J,31
03300		SOJGE I,TV2
03400		MOVE [XWD AC+1,1]
03500		BLT 17
03600		MOVE AC
03700		POPJ P,
03710	TVADD:	MOVEM AC
03715		MOVE [XWD 1,AC+1]
03720		BLT AC+17
03725		CALL 1,NUMVAL
03730		MOVEM 1,I
03735		PUSHJ P,TVAD
03740		MOVE [XWD AC+1,1]
03745		BLT 17
03750		MOVE AC
03755		SETZ A,
03760		POPJ P,
03765	
03800
03900	TVAD:	MOVEI L,1
04000		MOVEI M,1
04010		SKIPGE I
04020		SETZ I,
04030		CAILE I,3
04040		SETZ I,
04100	L1B:	MOVEI N,11
04600		MOVE C,BUFFER(M)
04700	L2B:	SETZ B,
04800		ROTC B,4
04900		MOVE @GREY(I)
05000		ADDM COLORS(L)
05100		AOJ L,
05200		SOJG N,L2B
05300		AOJ M,
05400		CAIE M,1001
05500		JRST L1B
05600		POPJ P,
05700
05800	;ADVANCE LENS
05900	LENS:	MOVEI 1,14
06000		MOVEM 1,STATUS
06100		MOVE 1,STATUS
06200		TRNE 1,20
06300		HALT		;HUNG
06400		TRNN 1,1
06500		JRST .-4
06600		SETZ 1,
06700		POPJ P,
06800
06900	;CLEAR COLORS DATA AREA
07000	ZIP:	MOVEI 1,11000
07100		SETZM COLORS(1)
07200		SOJGE 1,.-1
07300		SETZ 1,
07400		POPJ P,
07500
07600	;INPUT TV IMAGE
07700	INTV:	INIT 17,17
08200		SIXBIT/TV/
08300		0
08400		HALT		;INIT ERROR TV
08410		SKIPGE I
08420		SETZ I,
08430		CAILE I,3
08440		SETZ I,
08500		MOVE 2,WC(I)
08600		MOVE 3,WD(I)
08700		MOVEM 2,TVC
08800		MOVEM 3,TVD
08840		MOVE 2,WE(I)
08850		MOVEM 2,E
08900		SETZM TVCONI
09000		INPUT 17,E
09100		SETZ 1,
09200		POPJ P,
09300
09400	;TV CONTROL PARAMETERS
09500	WC:	071002		;CONO'S
09600	RC:	071002
09700	BC:	071002
09800	GC:	071002
09900
10000	WD:	100100010000	;DATAO'S
10100	RD:	100100010000
10200	BD:	100100010000
10300	GD:	100100010000
10400
10410	WE:	XWD -1000,BUFFER
10420	RE:	XWD -1000,BUFFER
10430	BE:	XWD -1000,BUFFER
10440	GE:	XWD -1000,BUFFER
10500	E:	XWD -1000,BUFFER
10600	TVC:	0		;CONO
10700	TVD:	0		;DATAO
10800	TVCONI:	0		;CONI
10900
11000	BUFFER:	1000
11100	BLOCK 1000
11200	COLORS:	0
11300	BLOCK 11000
11400
11500	AC:	0
11600	BLOCK 20
11700
11800	;GREY CODE
11900	WGREY: 12B8 ↔ 13B8 ↔ 11B8 ↔ 10B8 ↔ 15B8 ↔ 14B8 ↔ 16B8
12000		17B8 ↔ 5B8 ↔ 4B8 ↔ 6B8 ↔ 7B8
12100		2B8 ↔ 3B8 ↔ 1B8 ↔ 0
12200
12300	RGREY:	12B17 ↔ 13B17 ↔ 11B17 ↔ 10B17 ↔ 15B17 ↔ 14B17
12400		16B17 ↔ 17B17 ↔  5B17 ↔  4B17 ↔  6B17 ↔  7B17
12500		 2B17 ↔  3B17 ↔  1B17 ↔  0
12600
12700	BGREY:	12B26 ↔ 13B26 ↔ 11B26 ↔ 10B26 ↔ 15B26 ↔ 14B26
12800		16B26 ↔ 17B26 ↔  5B26 ↔  4B26 ↔  6B26 ↔  7B26
12900		 2B26 ↔  3B26 ↔  1B26 ↔  0
13000
13100	GGREY:	12 ↔ 13 ↔ 11 ↔ 10 ↔ 15 ↔ 14 ↔ 16 ↔ 17
13200		5 ↔ 4 ↔ 6 ↔ 7 ↔ 2 ↔ 3 ↔ 1 ↔ 0
13300	GREY:	WGREY(B) ↔ RGREY(B) ↔ BGREY(B) ↔ GGREY(B)
13400
13500	;SET CLIP LEVELS
13600
13700	CLIP:	MOVEM B,TEM1#
13800		MOVEM C,TEM2#
13900		CALL 1,NUMVAL
14000		ANDI A,3
14100		MOVEM A,TEM0#		;N TH COLOR
14200		MOVE A,TEM1
14300		CALL 1,NUMVAL
14400		ANDI A,7
14500		MOVEM A,TEM1		;BOTTOM CLIP LEVEL
14600		MOVE A,TEM2
14700		CALL 1,NUMVAL
14800		ANDI A,7		;TOP CLIP LEVEL
14900		MOVE B,TEM1
15000		MOVE C,TEM0
15300		ROT B,3
15400		IOR B,A
15500		ROT B,14
15600		IOR B,[1002]
15700		MOVEM B,WC(C)
15800		SETZ A,
15900		POPJ P,
16000
16100	;SET WINDOW PARAMETERS (N,X,Y,W,H)
16200	WINDOW:	MOVEM B,X#
16300		MOVEM C,Y#
16400		MOVEM D,W#
16500		MOVEM EE,H#
16600		CALL 1,NUMVAL
16700		ANDI A,3
16800		MOVEM A,TEM0	;N TH COLOR
16900		MOVEM A,EE
17000	DEFINE VALNUM (AA,AAA)
17100	{	MOVE A,AA
17200		CALL 1,NUMVAL
17300		MOVEM A,AA
17400		MOVEM A,AAA(EE)⎇
17500		VALNUM X,XXX
17600		VALNUM Y,YYY
17700		VALNUM W,WWW
17800		VALNUM H,HHH
17900		MOVE A,Y
18000		ROT A,9
18100		IOR A,X
18200		ROT A,9
18300		IOR A,W
18400		ROT A,9
18500		MOVE B,TEM0
18600		MOVEM A,WD(B)	;DATAO
18700		MOVE A,W
18800		IMUL A,H
18900		CAILE A,1000
19000		MOVEI A,1000
19100		MOVNS A
19200		HRLM A,WE(B)	;INPUT EFFECTIVE ADDRESS
19300		SETZ A,
19400		POPJ P,
19500
19600	;FETCH N TH COLOR'S INTENSITY AT X,Y
19700	FETCH:	MOVEM B,X
19800		MOVEM C,Y
19900		CALL 1,NUMVAL
20000		ANDI A,3
20100		MOVEM A,TEM0
20200		MOVE A,X
20300		CALL 1,NUMVAL
20400		MOVEM A,X
20500		MOVE A,Y
20600		CALL 1,NUMVAL
20700		MOVEM A,Y
20800
20900		MOVE EE,TEM0
21000		MOVE B,X	;(Y0-Y)*W*11 + (X0-X)
21100		SUB A,YYY(EE)
21200		SUB B,XXX(EE)
21300		IMUL A,WWW(EE)
21400		IMULI A,11
21500		ADD A,B
21600		MOVE B,COLORS(A)
21700
21800		TRNN EE,2
21900		ROT B,-22
22000		TRNN EE,1
22100		ROT B,-11
22200		ANDI B,777
22300		EXCH A,B
22400		JCALL 1,FIX1A
22500
22600
22700	XXX:	0 ↔ 0 ↔ 0 ↔ 0
22800	YYY:	0 ↔ 0 ↔ 0 ↔ 0
22900	WWW:	0 ↔ 0 ↔ 0 ↔ 0
23000	HHH:	0 ↔ 0 ↔ 0 ↔ 0
23010	TVSUB:	CALL 1,NUMVAL
23015		MOVEM 1,I
23020		MOVEM 0,TEM3#
23025		MOVEM L,TEM0
23030		MOVEM M,TEM1
23035		MOVEM N,TEM2#
23100		MOVEI L,1
23105		MOVEI M,1
23110		SKIPGE I
23115		SETZ I,
23120		CAILE I,3
23125		SETZ I,
23130	L1A:	MOVEI N,11
23135		MOVE C,BUFFER(M)
23140	L2A:	SETZ B,
23145		ROTC B,4
23150		MOVE @GREY(I)
23155		SUBM COLORS(L)
23160		AOJ L,
23165		SOJG N,L2A
23170		AOJ M,
23175		CAIE M,1001
23180		JRST L1A
23181	MOVE L,TEM0
23182	MOVE M,TEM1
23183	MOVE N,TEM2
23184	MOVE TEM3
23185		POPJ P,
24000	
24100	FOCUS:	CALL 1,NUMVAL
24200		MOVEM 1,L1
24300		SETZB 1,STATUS
24400		POPJ P,
24500	
24600	PAN:	CALL 1,NUMVAL
24700		MOVEM 1,L3
24800		SETZB 1,STATUS
24900		POPJ P,
25000	
25100	TILT:	CALL 1,NUMVAL
25200		MOVEM 1,L2
25300		SETZB 1,STATUS
25400		POPJ P,
25500	
25600	END
25700